home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Source Code / Visual Basic Source Code.iso / vbsource / pa32v303 / test30.frm (.txt) < prev    next >
Encoding:
Visual Basic Form  |  1996-02-20  |  3.6 KB  |  129 lines
  1. VERSION 2.00
  2. Begin Form TestForm 
  3.    Caption         =   "This is a test project for Project Analyzer"
  4.    ClientHeight    =   1080
  5.    ClientLeft      =   1095
  6.    ClientTop       =   1485
  7.    ClientWidth     =   5160
  8.    Height          =   1485
  9.    Icon            =   TEST30.FRX:0000
  10.    Left            =   1035
  11.    LinkTopic       =   "Form1"
  12.    ScaleHeight     =   1080
  13.    ScaleWidth      =   5160
  14.    Top             =   1140
  15.    Width           =   5280
  16.    Begin DriveListBox Drive1 
  17.       Height          =   315
  18.       Left            =   210
  19.       TabIndex        =   2
  20.       Top             =   630
  21.       Width           =   2535
  22.    End
  23.    Begin CommandButton Quit 
  24.       Caption         =   "Quit"
  25.       Height          =   330
  26.       Left            =   3780
  27.       TabIndex        =   0
  28.       Top             =   630
  29.       Width           =   1275
  30.    End
  31.    Begin Image Image1 
  32.       Height          =   480
  33.       Left            =   4515
  34.       Picture         =   TEST30.FRX:0302
  35.       Top             =   45
  36.       Width           =   480
  37.    End
  38.    Begin Label Label1 
  39.       Caption         =   "This program will not do anything"
  40.       Height          =   330
  41.       Left            =   210
  42.       TabIndex        =   1
  43.       Top             =   90
  44.       Width           =   4320
  45.    End
  46. ' ProjTest.Frm - a test project for Project Analyzer
  47. ' (C)1995 MyCompany Ltd.
  48. ' This is the form of the main screen
  49. ' This file also includes some important database routines
  50. DefStr W
  51. Dim DatabaseName As String
  52. Dim DatabaseOpen As Integer
  53. Dim Weekdays(0 To 6)
  54. Const MAX_BUTTONS = 50
  55. Dim Button(0 To MAX_BUTTONS) As CommandButton
  56. Dim FName As String
  57. ' This is a module-level variable that overrides the
  58. ' global variable FName in FILETEST.BAS
  59. Sub CloseDatabase ()
  60. ' Close the database
  61. ' Check that all information is up-to-date
  62. End Sub
  63. Function ExtensionOnly (ByVal File As String) As String
  64. ' Returns file name extension "BAS"
  65. ' This is a module-level function that will override
  66. ' the global function ExtensionOnly defined in FILETEST.BAS
  67. ExtensionOnly = Right(File, 3)
  68. End Function
  69. Function Fibonacci (ByVal n As Integer)
  70. ' Sample of a recursive call sequence
  71. ' This function is only called by SumFibonacci
  72. ' but not by any other procedure
  73. ' -> Fibonacci and SumFibonacci are dead code
  74. If n = 1 Then
  75.     Fibonacci = 1
  76. ElseIf n = 2 Then
  77.     Fibonacci = 1
  78.     Fibonacci = SumFibonacci(n - 1, n - 2)
  79. End If
  80. End Function
  81. Sub Form_Load ()
  82. ' Start of the program
  83. Set Button(0) = Quit
  84. ReadINIFile
  85. OpenDB
  86. RunTheProgram
  87. End Sub
  88. Sub Form_Unload (Cancel As Integer)
  89. ' Quit the program
  90. ' First close the database
  91. CloseDatabase
  92. End Sub
  93. Sub OpenDB ()
  94. ' Opening the DB
  95. ' Check for user rights
  96. ' Lock appropriate tables
  97. If ExtensionOnly(FName) = "TXT" Then
  98.     ' It is a text database
  99. ElseIf IsDir("C:\WINDOWS") Then
  100.     If DriveType("C:", Drive1) <> DRIVE_FIXED Then
  101.         ' Panic
  102.     Else
  103.         ' Don't panic
  104.     End If
  105. End If
  106. End Sub
  107. Sub Quit_Click ()
  108. Unload Me
  109. End Sub
  110. Sub ReadINIFile ()
  111. ' Read the configuration in PROJTEST.INI
  112. ' Note: If PROJTEST.INI doesn't exist, use defaults
  113. IsThere = IsFile("PROJTEST.INI")
  114. End Sub
  115. Sub RunTheProgram ()
  116. ' Run the program only if there is at least 1 MB free
  117. ' disk space
  118. ' Otherwise show error message
  119. If DiskSpaceFree("C:") < 1024 ^ 2 Then
  120. End If
  121. End Sub
  122. Function SumFibonacci (a, b)
  123. ' Sample of a recursive call sequence
  124. ' This function is only called by Fibonacci
  125. ' but not by any other procedure
  126. ' -> Fibonacci and SumFibonacci are dead code
  127. SumFibonacci = Fibonacci(a) + Fibonacci(b)
  128. End Function
  129.